home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS14.ADF / AmigaBasicProgs / BMAPReader / BmapReader < prev    next >
Text File  |  1989-01-28  |  10KB  |  339 lines
  1. Initialize:
  2.   FALSE = 0 : TRUE = -1 ' Just because!
  3.   BobRight = 230 : BobBottom = 90 ' The sides of our requestor 
  4.   DEF FNArraySize& = 3 + INT((BobRight + 16)/16)*(BobBottom+1)*2
  5.   DECLARE FUNCTION Move LIBRARY    
  6.   DECLARE FUNCTION SetDrMd LIBRARY 
  7.   LIBRARY "graphics.library"
  8.   Title$ = "   .bmap Reader                     Tim Jones "
  9.   Title$ = Title$ + CHR$(169) + " 1986 AmSoft Developement"
  10.   WINDOW 1,Title$,(0,0)-(631,186),0
  11.   PALETTE 0,0,0,0
  12.   PALETTE 3,.8,.2,.1
  13.   PALETTE 1,.1,.7,.1
  14.   PALETTE 2,.9,.9,.1
  15.   Rp& = WINDOW(8)
  16. Start:
  17.   COLOR 1,0 : CLOSE 1
  18.   GOSUB NameRequestor
  19.   IF NOT Okay THEN
  20.     CLS : LIBRARY CLOSE
  21.     WINDOW 1,"BmapReader",(0,0)-(617,186),15,-1 : STOP
  22.   END IF
  23.   ON ERROR GOTO FileProb ' this screws things up if you use other than the
  24.                          ' default workbench screen
  25.   IF UCASE$(RIGHT$(FileName$,5)) <> ".BMAP" THEN
  26.     FileName$ = FileName$ + ".bmap"
  27.   END IF
  28.   OPEN FileName$ FOR INPUT AS 1
  29.   Prompt$ = "" : Prompt2$ = " Output to Printer?"
  30.   GOSUB YNRequestor : IF Okay THEN fPrt = TRUE : GOTO Printer
  31.   CLS
  32.   LINE(3,13)-(628,170),1,b
  33.   LINE(4,13)-(627,170),1,b
  34.   Length& = LOF(1)
  35.   LOCATE 23,1 : PRINT Length&;"Bytes read.   FILE: ";: COLOR 2,0 : PRINT FileName$;
  36.   CALL Move&(Rp&,10,10) : COLOR 3,0
  37.   PRINT "Routine Name         Address    d0 d1 d2 d3 d4 d5 d6 d7   a0 a1 a2 a3 a4"
  38.   COLOR 1,0
  39. GetTheFile:
  40.   WHILE NOT EOF(1)
  41.     FOR L = 3 TO 21 
  42.     IF EOF(1) THEN
  43.       FOR J = L TO 21
  44.         LOCATE J,2
  45.         PRINT SPACE$(75)
  46.       NEXT J  
  47.       GOTO Finished
  48.     END IF
  49.     GOSUB GetRoutName
  50.       COLOR 1,0
  51.       LOCATE L,2
  52.       PRINT " ";Routine$
  53.     GOSUB GetEntryAdd
  54.       LOCATE L,25
  55.       IF LEN(Address$(2)) = 1 THEN
  56.         Address$(2) = "0" + Address$(2)
  57.       END IF
  58.       PRINT Address$(1);Address$(2)
  59.     GOSUB GetRegInfo
  60.       LOCATE L,35
  61.       PRINT 
  62.     NEXT L
  63.     COLOR 0,3
  64.     LINE(386,173)-(612,185),3,bf
  65.     LINE(388,174)-(610,184),0,b
  66.     CALL Move&(Rp&,394,182) : PRINT "F1 continues <> F10 aborts";
  67.     WaitKey:
  68.       In$ = INKEY$ : IF In$ = "" THEN WaitKey
  69.       IF In$ = CHR$(138) THEN
  70.         LINE(386,173)-(612,185),0,bf
  71.         GOTO Finished
  72.       END IF        
  73.       IF In$ <> CHR$(129) THEN WaitKey
  74.       COLOR 1,0
  75.       LINE(386,173)-(612,185),0,bf     
  76.   WEND
  77.   GOTO Finished
  78.   
  79. GetRoutName:  
  80.   Routine$ = ""
  81.   GOSUB GetChar
  82.   WHILE Char$ <> CHR$(0)
  83.     Routine$ = Routine$ + Char$
  84.     GOSUB GetChar
  85.   WEND
  86.   IF LEN(Routine$) < 30 THEN
  87.     Routine$ = Routine$ + SPACE$(20 - LEN(Routine$))
  88.   END IF
  89. RETURN
  90.  
  91. GetEntryAdd:
  92.   FOR ii = 1 TO 2
  93.     GOSUB GetChar
  94.     Address$(ii) = HEX$(ASC(Char$))
  95.   NEXT ii
  96. RETURN
  97.  
  98. GetRegInfo:
  99.   LOCATE L,35 : PRINT SPACE$(42);
  100.   WHILE Char$ <> CHR$(0)
  101.     GOSUB GetChar
  102.     COLOR 2,0
  103.     Register = ASC(Char$)
  104.     GOSUB R1
  105.   WEND
  106.   IF fPrt THEN PRINT #4," "
  107. RETURN
  108.  
  109. GetChar:
  110.   IF NOT EOF(1) THEN Char$ = INPUT$(1,1)
  111. RETURN
  112.  
  113. Finished:
  114.   COLOR 3,0
  115.   LOCATE 23,1
  116.   PRINT SPACE$(78);
  117.   LOCATE 23,1
  118.   PRINT " Do you wish to examine another .BMAP file (Y/N)?";
  119. test:
  120.   In$ = INKEY$ : IF In$ = "" THEN test
  121.   IF UCASE$(In$) <> "Y" THEN
  122.     CLS : CLOSE 1 : LIBRARY CLOSE : WINDOW CLOSE 1
  123.     WINDOW 1,"BmapReader",(0,0)-(617,186),15,-1 : STOP
  124.   END IF
  125.   GOTO Start
  126.     
  127. R1:            
  128.   IF Register < 1 THEN RETURN
  129.   IF Register > 8 THEN R2
  130.   IF fPrt THEN
  131.     PRINT #4,CHR$(141);TAB(32 + (Register * 3));"#";
  132.     RETURN
  133.   END IF
  134.   LOCATE L,(32 + (Register * 3))
  135.   PRINT "#"
  136. RETURN
  137.  
  138. R2:
  139.   IF fPrt THEN
  140.     PRINT #4,CHR$(141);TAB(34 + (Register * 3));"#";
  141.     RETURN
  142.   END IF
  143.   LOCATE L,(34 + (Register *3))
  144.   PRINT "#"
  145. RETURN
  146.  
  147. Printer:
  148.  
  149.   OPEN "LPT1:BIN" FOR OUTPUT AS 4
  150.   PRINT #4,CHR$(14);"Contents of file ";FileName$
  151.   PRINT #4," "
  152.   WHILE NOT EOF(1)
  153.     PRINT #4,"Routine Name         Address    d0 d1 d2 d3 d4 d5 d6 d7   a0 a1 a2 a3 a4"
  154.     PRINT #4,"------------         -------    -- -- -- -- -- -- -- --   -- -- -- -- --"
  155.     FOR L = 1 TO 54 
  156.     IF EOF(1) THEN
  157.       GOTO Finished
  158.     END IF
  159.     GOSUB GetRoutName
  160.       PRINT #4," ";Routine$;
  161.     GOSUB GetEntryAdd
  162.       IF LEN(Address$(2)) = 1 THEN
  163.         Address$(2) = "0" + Address$(2)
  164.       END IF
  165.       PRINT #4,"  ";Address$(1);Address$(2);
  166.     GOSUB GetRegInfo
  167.     NEXT L
  168.     PRINT #4,CHR$(12)
  169.   WEND
  170.   PRINT #4,CHR$(12)
  171.   CLOSE 4 : fPrt = FALSE
  172.   GOTO Start
  173.   
  174. FileProb:
  175.  
  176.   flag = ERR
  177.   Prompt$ = ""
  178.   Prompt2$ = "   Error! >>"+ STR$(ERR)
  179.   GOSUB YNRequestor
  180.   IF NOT Okay THEN
  181.     LIBRARY CLOSE
  182.     CLOSE 1
  183.     WINDOW CLOSE 1
  184.     WINDOW 1,"BmapReader",(0,0)-(617,186),31,-1
  185.     END
  186.   END IF
  187.   RESUME Start
  188.  
  189. NameRequestor:   
  190.   Size& = FNArraySize&\2 
  191.   DIM ScrSav&(Size&)     
  192.   GET(40,40)-(230,90),ScrSav&  
  193. DrawRequestorToScreen2:
  194.   LINE(40,40)-(230,90),1,bf   'Main requestor box
  195.   LINE(40,40)-(230,90),0,b    'outline for main requestor box
  196.   LINE(44,42)-(226,88),0,b    'secondary outline for main box
  197.   LINE(50,74)-(72,86),3,bf    'OK button box
  198.   LINE(50,74)-(72,86),0,b     'OK outline
  199.   LINE(150,74)-(220,86),3,bf  'CANCEL button box
  200.   LINE(150,74)-(220,86),0,b   'CANCEL outline
  201.   CALL Move&(Rp&,53,83)       'Position for printing OK in button
  202.   COLOR 0,3 : PRINT "OK"      'print it
  203.   CALL Move&(Rp&,160,83)      'Position for printing CANCEL button
  204.   COLOR 0,3 : PRINT "CANCEL"  'print it
  205.   LINE(53,50)-(216,62),3,b
  206.   Curs = 55 : LINE(Curs,52)-(Curs+7,60),2,bf  ' Print the pseudo-cursor
  207.   CALL Move&(Rp&,53,71) : COLOR 0,1 : PRINT "   Enter File Name"
  208.   C$ = INKEY$ : WHILE C$ <> "" : C$ = INKEY$ : WEND 'Empty keyboard buffer
  209.   FileName$ = ""
  210.  
  211. AccessLoop: ' Wait for click in string box or CANCEL
  212.     
  213.   I = MOUSE(0) : X = MOUSE(1) : Y = MOUSE(2)
  214.   IF I <> 0 THEN
  215.     WHILE I <> 0 : I = MOUSE(0) : X = MOUSE(1) : Y = MOUSE(2) : WEND
  216.     Y=Y-1 ' This is due to a difference in MOUSE(2) and the actual Window
  217.           ' location
  218.     IF X > 150 AND X < 220 AND Y > 74 AND Y < 86 THEN ' Check for CANCEL
  219.       CALL SetDrMd&(Rp&,2) : LINE(151,75)-(219,85),0,bf
  220.       CALL SetDrMd&(Rp&,1)        
  221.       Okay = FALSE : FOR Delay = 1 TO 1000 : NEXT Delay
  222.       PUT(40,40),ScrSav&,PSET
  223.       ERASE ScrSav& : COLOR 1,0 : RETURN
  224.     END IF
  225.     IF X > 53 AND X < 216 AND Y > 50 AND Y < 62 THEN
  226.       LINE(Curs,52)-(Curs+7,60),0,bf
  227.       FOR Delay = 1 TO 50 : NEXT Delay
  228.       LINE(Curs,52)-(Curs+7,60),2,bf
  229.       WHILE INKEY$ <> "" : WEND
  230.       GOTO Loop
  231.     END IF
  232.   END IF  
  233.   GOTO AccessLoop
  234.       
  235. Loop: ' We do this until CANCEL, OK or Carriage Return
  236.   
  237.   C$ = INKEY$ : I = MOUSE(0) : X = MOUSE(1) : Y = MOUSE(2)
  238.   IF I <> 0 THEN
  239.     WHILE I <> 0 : I = MOUSE(0) : X = MOUSE(1) : Y = MOUSE(2) : WEND
  240.     Y=Y-1 ' This is due to a difference in MOUSE(2) and the actual Window
  241.           ' location
  242.     IF X > 150 AND X < 220 AND Y > 74 AND Y < 86 THEN ' Check for CANCEL
  243.       CALL SetDrMd&(Rp&,2) : LINE(151,75)-(219,85),0,bf
  244.       CALL SetDrMd&(Rp&,1)        
  245.       Okay = FALSE : FOR Delay = 1 TO 1000 : NEXT Delay
  246.       PUT(40,40),ScrSav&,PSET
  247.       ERASE ScrSav& : COLOR 1,0 : RETURN
  248.     END IF
  249.     IF X > 50 AND X < 72 AND Y > 74 AND Y < 86 AND LEN(FileName$) > 0 THEN
  250.       ' Check for OK and length of file
  251.       CALL SetDrMd&(Rp&,2) : LINE(51,75)-(71,85),0,bf
  252.       CALL SetDrMd&(Rp&,1)
  253.       FOR Delay = 1 TO 1000 : NEXT Delay : Okay = TRUE : fExist = TRUE
  254.       PUT(40,40),ScrSav&,PSET
  255.       ERASE ScrSav& : COLOR 1,0 : RETURN
  256.     END IF
  257.   END IF
  258.   IF C$ = "" THEN GOTO Loop
  259.   IF LEN(FileName$) = 0 THEN IF C$ < "A" AND ASC(C$) <> 13 GOTO Loop
  260.     ' Don't allow non-Alpha characters as first character
  261.   IF ASC(C$) = 13 THEN
  262.     Okay = TRUE : fExist = TRUE
  263.     PUT(40,40),ScrSav&,PSET
  264.     ERASE ScrSav& : COLOR 1,0 : RETURN
  265.   END IF
  266.   IF ASC(C$) = 8 THEN
  267.     ' Capture the BackSpace and fix display and filename
  268.     FileName$ = LEFT$(FileName$,LEN(FileName$)-1)
  269.     LINE(Curs,52)-(Curs+7,60),1,bf
  270.     Curs = Curs-8 : LINE(Curs,52)-(Curs+7,60),2,bf
  271.     GOTO Loop
  272.   END IF
  273.   IF LEN(FileName$) = 19 THEN GOTO Loop
  274.   IF ASC(C$) = 8 THEN Loop
  275.   IF C$ < " " OR (C$ > "Z" AND C$ < "a") OR C$ > "z" GOTO Loop
  276.   FileName$ = FileName$ + C$
  277.   LINE(Curs,52)-(Curs+7,60),1,bf
  278.   COLOR 0,1 : CALL Move&(Rp&,0,59) : PRINT PTAB(Curs);C$;
  279.   Curs = Curs + 8 : LINE(Curs,52)-(Curs+7,60),2,bf
  280.   GOTO Loop
  281.  
  282.  
  283. YNRequestor:
  284.  
  285.   Size& = FNArraySize&\2 'to reserve memory for the GET statement
  286.   DIM ScrSav&(Size&)     'this is the actual array to hold the bitmap
  287.   GET(40,40)-(230,90),ScrSav&  'defines a rectangle and remembers it as
  288.   LINE(40,40)-(230,90),2,bf   'Main requestor box
  289.   LINE(40,40)-(230,90),0,b    'outline for main requestor box
  290.   LINE(44,42)-(226,88),0,b    'secondary outline for main box
  291.   LINE(50,74)-(72,86),3,bf    'OK button box
  292.   LINE(50,74)-(72,86),0,b     'OK outline
  293.   LINE(150,74)-(220,86),3,bf  'CANCEL button box
  294.   LINE(150,74)-(220,86),0,b   'CANCEL outline
  295.   CALL Move&(Rp&,53,83)       'Position for printing OK in button
  296.   COLOR 0,3 : PRINT "OK"      'print it
  297.   CALL Move&(Rp&,160,83)      'Position for printing CANCEL button
  298.   COLOR 0,3 : PRINT "CANCEL"  'print it
  299.   CALL Move&(Rp&,54,52)       'Position for printing first line of text
  300.   COLOR 0,2 : PRINT Prompt$   'print it
  301.   CALL Move&(Rp&,54,62)       'Position for printing second line of text
  302.   COLOR 3,2 : PRINT Prompt2$  'print it
  303.  
  304. GetButton2:  
  305.  
  306.   ' This waits for a mouse click (left mouse button)
  307.   
  308.   I = MOUSE(0) : X = MOUSE(1) : Y = MOUSE(2)
  309.   IF I <> 0 THEN
  310.     WHILE I<>0 : I = MOUSE(0) : X = MOUSE(1) : Y = MOUSE(2) : Y = Y-1
  311.     WEND
  312. Cancel: ' Check to see if the CANCEL button is selected   
  313.     IF X > 150 AND X < 220 AND Y > 74 AND Y < 86 THEN
  314.       CALL SetDrMd&(Rp&,2)    ' COMPLIMENT the CANCEL button
  315.       LINE(151,75)-(219,85),0,bf
  316.       CALL SetDrMd&(Rp&,1)
  317.       FOR Delay = 1 TO 1000 : NEXT Delay ' Let the user SEE his/her choice
  318.       PUT(40,40),ScrSav&,PSET ' Replace the old screen display
  319.       ERASE ScrSav&           ' Erase the Array
  320.       Okay = FALSE            ' Indicates that CANCEL was selected
  321.       COLOR 1,0
  322.       RETURN
  323.     END IF
  324. Ok:  ' Check to see if the OK button is selected
  325.     IF X > 50 AND X < 72 AND Y > 74 AND Y < 86 THEN
  326.       CALL SetDrMd&(Rp&,2)  ' COMPLIMENT the OK button
  327.       LINE(51,75)-(71,85),0,bf
  328.       CALL SetDrMd&(Rp&,1)
  329.       FOR Delay = 1 TO 1000 : NEXT Delay ' Let the user SEE his/her choice
  330.       PUT(40,40),ScrSav&,PSET        ' Replace the old screen display
  331.       Okay = TRUE                    ' Erase the Array
  332.       ERASE ScrSav&                  ' Indicates that OK was selected
  333.       COLOR 1,0
  334.       RETURN
  335.     END IF
  336.   END IF
  337.   GOTO GetButton2 ' Until a button is selected
  338.   
  339.